ADA Programming Guide/ADA Programming Guide.iso/adatutor/csparts/clibody.src

Text File | 1996-01-30 | 41.6 KB | 1,197 lines

--::::::::::
--clibody.inc
--::::::::::
-- This include file
clibody.inc
-- Select one of these package
-- bodies, depending on your compiler
--    CLIALUNX - Alsys Ada for UNIX
--    CLIALDOS - Alsys Ada for DOS
--    CLICAIS  - CAIS
--    CLIINTGR - Integr/Ada
--    CLIMERDN - Meridian Ada
--    CLIVERDX - Verdix Ada
--    CLIVMS   - DEC Ada
--    CLIGENRL - Any other compiler
clialunx.ada
clialdos.ada
clicais.ada
cligenrl.ada
cliintgr.ada
climerdn.ada
cliverdx.ada
clivms.ada
--::::::::::
--clialunx.ada
--::::::::::
-- This implementation of Package Body CLI is Alsys-specific (SUN).
-- It requires the Alsys package SYSTEM_ENVIRONMENT.
-- Alsys Ada, Version 3.2
with TEXT_IO;
with SYSTEM_ENVIRONMENT;
package body CLI is

   LOCAL_ARGC : NATURAL := SYSTEM_ENVIRONMENT.ARG_COUNT;
   -- Value of ARGC as stored internally

   procedure INITIALIZE (PROGRAM_NAME        : in STRING;
                         COMMAND_LINE_PROMPT : in STRING) is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    INITIALIZE performs necessary initializations.
      --|DESIGN DESCRIPTION:
      --|    No initialization needed
      --=========================================================

   begin
      null;
   end INITIALIZE;

   function ARGC return NATURAL is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGC returns the argument count.
      --|DESIGN DESCRIPTION:
      --|    Return LOCAL_ARGC
      --=========================================================

   begin
      return LOCAL_ARGC;
   end ARGC;

   function ARGV (INDEX : in NATURAL) return STRING is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGV returns the indicated argument string.
      --|DESIGN DESCRIPTION:
      --|    If INDEX is out of range, raise INVALID_INDEX
      --|    Return GET_FROM_LIST(INDEX)
      --=========================================================

   begin
      if INDEX >= LOCAL_ARGC then
         raise INVALID_INDEX;
      end if;
      return SYSTEM_ENVIRONMENT.ARG_VALUE (INDEX);
   exception
      when INVALID_INDEX  =>
         raise ;
      when others    =>
         raise UNEXPECTED_ERROR;
   end ARGV;

end CLI;
--::::::::::
--clialdos.ada
--::::::::::
--::::::::::
--clialsys.ada
--::::::::::
-- This implementation of Package Body CLI is Alsys-specific (SUN).
-- It requires the Alsys package DOS.
-- Alsys Ada, Version 5
with DOS;
package body CLI is

   LOCAL_ARGC : NATURAL;

   type TOKEN_SCAN_STATE is (OUTSIDE_OF_TOKEN, INSIDE_OF_TOKEN);

   function ARGC_VALUE (TOKENS : in STRING) return NATURAL is
      COUNTER : NATURAL := 0;
      CURRENT_STATE : TOKEN_SCAN_STATE := OUTSIDE_OF_TOKEN;
   begin
      for I in TOKENS'FIRST .. TOKENS'LAST loop
          case CURRENT_STATE is
              when OUTSIDE_OF_TOKEN =>
                  if TOKENS(I) > ' ' then
                      COUNTER := COUNTER + 1;
                      CURRENT_STATE := INSIDE_OF_TOKEN;
                  end if;
              when INSIDE_OF_TOKEN =>
                  if TOKENS(I) <= ' ' then
                      CURRENT_STATE := OUTSIDE_OF_TOKEN;
                  end if;
          end case;
      end loop;
      return COUNTER;
   end ARGC_VALUE;

   procedure INITIALIZE (PROGRAM_NAME        : in STRING;
                         COMMAND_LINE_PROMPT : in STRING) is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    INITIALIZE performs necessary initializations.
      --|DESIGN DESCRIPTION:
      --|    Set the value of LOCAL_ARGC by parsing tokens.
      --=========================================================

   begin
      LOCAL_ARGC := ARGC_VALUE (DOS.GET_PARMS) + 1;
   end INITIALIZE;

   function ARGC return NATURAL is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGC returns the argument count.
      --|DESIGN DESCRIPTION:
      --|    Return LOCAL_ARGC.
      --=========================================================

   begin
      return LOCAL_ARGC;
   end ARGC;

   function ARG_VALUE (TOKENS : in STRING; INDEX : in NATURAL)
     return STRING is
       FIRST, LAST, COUNTER : NATURAL;
       CURRENT_STATE : TOKEN_SCAN_STATE := OUTSIDE_OF_TOKEN;
   begin
      FIRST := TOKENS'FIRST;
      LAST := TOKENS'FIRST-1;
      COUNTER := 0;
      if INDEX = 0 then
          return DOS.GET_PROGRAM_NAME;
      else
          for I in TOKENS'FIRST .. TOKENS'LAST loop
              case CURRENT_STATE is
                  when OUTSIDE_OF_TOKEN =>
                      if TOKENS(I) > ' ' then
                          COUNTER := COUNTER + 1;
                          CURRENT_STATE := INSIDE_OF_TOKEN;
                          if COUNTER = INDEX then
                              FIRST := I;
                              LAST := TOKENS'LAST;
                          end if;
                      end if;
                  when INSIDE_OF_TOKEN =>
                      if TOKENS(I) <= ' ' then
                          CURRENT_STATE := OUTSIDE_OF_TOKEN;
                          if COUNTER = INDEX then
                              LAST := I - 1;
                          end if;
                      end if;
              end case;
          end loop;
          if LAST < FIRST then
            return "";
          else
            return TOKENS(FIRST .. LAST);
          end if;
      end if;
   end ARG_VALUE;

   function ARGV (INDEX : in NATURAL) return STRING is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGV returns the indicated argument string.
      --|DESIGN DESCRIPTION:
      --|    If INDEX is out of range, raise INVALID_INDEX
      --|    Run parse and return desired token.
      --=========================================================

   begin
      if INDEX >= LOCAL_ARGC then
         raise INVALID_INDEX;
      end if;
      return ARG_VALUE (DOS.GET_PARMS, INDEX);
   exception
      when INVALID_INDEX  =>
         raise ;
      when others    =>
         raise UNEXPECTED_ERROR;
   end ARGV;

begin -- Initialization section
  INITIALIZE("", "");
end CLI;
--::::::::::
--clicais.ada
--::::::::::
-- This implementation of Package Body CLI interfaces thru a CAIS
-- (CAIS = Common APSE Interface Set, where APSE = Ada Programming
-- Support Environment).
-- The definition of CAIS used was DoD-STD-1838, dated 9 October 1986.
-- Note: THIS IS UNTESTED BUT BELIEVED TO BE CORRECT (no working CAIS
--       implementation was available to test this against).
with CAIS_PROCESS_DEFINITIONS;
with CAIS_PROCESS_MANAGEMENT;
with CAIS_LIST_MANAGEMENT;
package body CLI is

   LOCAL_ARGC : NATURAL := 1;
   -- Local ARGC value used internally

   package STRING_LIST is

      NUMBER_OF_STRINGS : NATURAL := 0;

      procedure ADD_TO_LIST (ITEM : in STRING);
      function GET_FROM_LIST (ITEM : in NATURAL) return STRING;

   end STRING_LIST;

   package body STRING_LIST is

      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
      type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
         record
            DS   : STRING (1 .. LENGTH);
            NEXT : DYNAMIC_STRING;
         end record;

      FIRST : DYNAMIC_STRING := null;
      LAST  : DYNAMIC_STRING := null;

      procedure ADD_TO_LIST (ITEM : in STRING) is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    ADD_TO_LIST adds the ITEM string to the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    Create new DYNAMIC_STRING_OBJECT of the proper length
         --|    Set DS field of new object to the ITEM string
         --|    Set the NEXT field of the new object to NULL
         --|    If FIRST pointer is null
         --|      Set FIRST and LAST to point to the new object
         --|    Else
         --|      Set LAST.NEXT to point to the new object
         --|      Set LAST to point to the new object
         --|    End if
         --|    Increment NUMBER_OF_STRINGS
         --=========================================================

         TEMP : DYNAMIC_STRING;
      begin
         TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
         TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
         TEMP.NEXT                  := null;
         if FIRST = null then
            FIRST := TEMP;
            LAST  := TEMP;
         else
            LAST.NEXT := TEMP;
            LAST      := TEMP;
         end if;
         NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
      end ADD_TO_LIST;

      function GET_FROM_LIST (ITEM : in NATURAL) return STRING is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    GET_FROM_LIST returns the ITEM string from the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    If ITEM > 0
         --|        Advance to desired item
         --|    End If
         --|    Return the DS field of the desired item
         --=========================================================

         ROVER : DYNAMIC_STRING := FIRST;
      begin
         if ITEM > 0 then
            for I in 1 .. ITEM loop
               ROVER := ROVER.NEXT;
            end loop;
         end if;
         return ROVER.DS;
      end GET_FROM_LIST;

   end STRING_LIST;

   procedure INITIALIZE (PROGRAM_NAME        : in STRING;
                         COMMAND_LINE_PROMPT : in STRING) is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    INITIALIZE prompts the user for the command line
      --|    arguments and loads the linked list with them.
      --|DESIGN DESCRIPTION:
      --|    Set the first list object to PROGRAM_NAME
      --|    Get the list of parameters for the process
      --|    For each parameter, loop
      --|        Extract the next parameter (item)
      --|        Convert the parameter (item) to text
      --|        Add text to the list
      --|    End Loop
      --|    Set LOCAL_ARGC to NUMBER_OF_STRINGS
      --=========================================================

      PARAMETERS           : CAIS_PROCESS_DEFINITIONS.PARAMETER_LIST;
      CURRENT_PARAMETER    : CAIS_PROCESS_DEFINITIONS.PARAMETER_LIST;
      NUMBER_OF_PARAMETERS : CAIS_LIST_MANAGEMENT.LIST_SIZE;

   begin
      STRING_LIST.ADD_TO_LIST(PROGRAM_NAME);
      CAIS_PROCESS_MANAGEMENT.GET_PARAMETERS (PARAMETERS);
      NUMBER_OF_PARAMETERS := CAIS_LIST_MANAGEMENT.NUMBER_OF_ITEMS
            (PARAMETERS);
      for I in 1 .. NUMBER_OF_PARAMETERS loop
         CAIS_LIST_MANAGEMENT.CAIS_LIST_ITEM.EXTRACT_VALUE
               (FROM_LIST     => PARAMETERS,
                ITEM_POSITION => I,
                VALUE         => CURRENT_PARAMETER);
         STRING_LIST.ADD_TO_LIST
               (CAIS_LIST_MANAGEMENT.TEXT_FORM(CURRENT_PARAMETER));
      end loop;
      LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
   end INITIALIZE;

   function ARGC return NATURAL is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGC returns the argument count.
      --|DESIGN DESCRIPTION:
      --|    Return LOCAL_ARGC
      --=========================================================

   begin
      return LOCAL_ARGC;
   end ARGC;

   function ARGV (INDEX : in NATURAL) return STRING is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGV returns the indicated argument string.
      --|DESIGN DESCRIPTION:
      --|    If INDEX is out of range, raise INVALID_INDEX
      --|    Return GET_FROM_LIST(INDEX)
      --=========================================================

   begin
      if INDEX >= ARGC then
         raise INVALID_INDEX;
      end if;
      return STRING_LIST.GET_FROM_LIST (INDEX);
   exception
      when INVALID_INDEX  =>
         raise ;
      when others    =>
         raise UNEXPECTED_ERROR;
   end ARGV;

end CLI;
--::::::::::
--cligenrl.ada
--::::::::::
-- This implementation of Package Body CLI is general-purpose.
-- Using TEXT_IO, it prompts the user for input arguments and
-- accepts these arguments via a GET_LINE call.
with TEXT_IO;
package body CLI is

   LOCAL_ARGC : NATURAL := 0;

   package STRING_LIST is

      NUMBER_OF_STRINGS : NATURAL := 0;

      procedure ADD_TO_LIST (ITEM : in STRING);
      function GET_FROM_LIST (ITEM : in NATURAL) return STRING;

   end STRING_LIST;

   package body STRING_LIST is

      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
      type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
         record
            DS   : STRING (1 .. LENGTH);
            NEXT : DYNAMIC_STRING;
         end record;

      FIRST : DYNAMIC_STRING := null;
      LAST  : DYNAMIC_STRING := null;

      procedure ADD_TO_LIST (ITEM : in STRING) is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    ADD_TO_LIST adds the ITEM string to the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    Create new DYNAMIC_STRING_OBJECT of the proper length
         --|    Set DS field of new object to the ITEM string
         --|    Set the NEXT field of the new object to NULL
         --|    If FIRST pointer is null
         --|      Set FIRST and LAST to point to the new object
         --|    Else
         --|      Set LAST.NEXT to point to the new object
         --|      Set LAST to point to the new object
         --|    End if
         --|    Increment NUMBER_OF_STRINGS
         --=========================================================

         TEMP : DYNAMIC_STRING;
      begin
         TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
         TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
         TEMP.NEXT                  := null;
         if FIRST = null then
            FIRST := TEMP;
            LAST  := TEMP;
         else
            LAST.NEXT := TEMP;
            LAST      := TEMP;
         end if;
         NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
      end ADD_TO_LIST;

      function GET_FROM_LIST (ITEM : in NATURAL) return STRING is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    GET_FROM_LIST returns the ITEM string from the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    If ITEM > 0
         --|        Advance to desired item
         --|    End If
         --|    Return the DS field of the desired item
         --=========================================================

         ROVER : DYNAMIC_STRING := FIRST;
      begin
         if ITEM > 0 then
            for I in 1 .. ITEM loop
               ROVER := ROVER.NEXT;
            end loop;
         end if;
         return ROVER.DS;
      end GET_FROM_LIST;

   end STRING_LIST;

   procedure INITIALIZE (PROGRAM_NAME        : in STRING;
                         COMMAND_LINE_PROMPT : in STRING) is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    INITIALIZE prompts the user for the command line
      --|    arguments and loads the linked list with them.
      --|DESIGN DESCRIPTION:
      --|    Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|    Set the first list object to PROGRAM_NAME
      --|    Prompt the user with COMMAND_LINE_PROMPT and
      --|      get his response
      --|    Over number of characters in line, loop
      --|        Case CURRENT_STATE
      --|            When LOOKING_FOR_TOKEN
      --|                If character is not white-space
      --|                    Set CURRENT_STATE to IN_TOKEN
      --|                    If character is quote (")
      --|                        Set QUOTED to TRUE
      --|                        Set START to the character's index + 1
      --|                    Else
      --|                        Set QUOTED to FALSE
      --|                        Set START to the character's index
      --|                    End IF
      --|                End If
      --|            When IN_TOKEN
      --|                If QUOTED
      --|                    If character is quote (")
      --|                        Set STOP to the previous character's index
      --|                        Add slice from START to STOP to list
      --|                        Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|                    End If
      --|                ElsIF character is white-space
      --|                    Set STOP to the previous character's index
      --|                    Add slice from START to STOP to list
      --|                    Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|                End If
      --|        End Case
      --|    End Loop
      --|    If CURRENT_STATE is IN_TOKEN
      --|        Set STOP to the previous character's index
      --|        Add slice from START to STOP to list
      --|    End if
      --|    Set LOCAL_ARGC to NUMBER_OF_STRINGS
      --|    Output NEW_LINE (to reset column count in TEXT_IO)
      --=========================================================

      ARGCOUNT      : NATURAL := 1;
      INLINE        : STRING (1 .. 400);
      LAST          : NATURAL;
      START         : NATURAL;
      STOP          : NATURAL;
      QUOTED        : BOOLEAN;
      type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
      CURRENT_STATE : STATE   := LOOKING_FOR_TOKEN;
   begin
      STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
      TEXT_IO.PUT (COMMAND_LINE_PROMPT);
      TEXT_IO.GET_LINE (INLINE, LAST);
      for I in 1 .. LAST loop
         case CURRENT_STATE is
            when LOOKING_FOR_TOKEN  =>
               if INLINE (I) > ' ' then
                  CURRENT_STATE := IN_TOKEN;
                  if INLINE (I) = '"' then
                     QUOTED := TRUE;
                     START  := I;
                  else
                     QUOTED := FALSE;
                     START  := I;
                  end if;
               end if;
            when IN_TOKEN =>
               if QUOTED then
                  if INLINE (I) = '"' then
                     STOP          := I;
                     STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
                     CURRENT_STATE := LOOKING_FOR_TOKEN;
                  end if;
               elsif INLINE (I) <= ' ' then
                  STOP          := I - 1;
                  STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
                  CURRENT_STATE := LOOKING_FOR_TOKEN;
               end if;
         end case;
      end loop;
      if CURRENT_STATE = IN_TOKEN then
         STOP := LAST;
         STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
      end if;
      LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
      TEXT_IO.NEW_LINE;
   end INITIALIZE;

   function ARGC return NATURAL is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGC returns the argument count.
      --|DESIGN DESCRIPTION:
      --|    Return LOCAL_ARGC
      --=========================================================

   begin
      return LOCAL_ARGC;
   end ARGC;

   function ARGV (INDEX : in NATURAL) return STRING is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGV returns the indicated argument string.
      --|DESIGN DESCRIPTION:
      --|    If INDEX is out of range, raise INVALID_INDEX
      --|    Return GET_FROM_LIST(INDEX)
      --=========================================================

   begin
      if INDEX >= LOCAL_ARGC then
         raise INVALID_INDEX;
      end if;
      return STRING_LIST.GET_FROM_LIST (INDEX);
   exception
      when INVALID_INDEX  =>
         raise ;
      when others    =>
         raise UNEXPECTED_ERROR;
   end ARGV;

end CLI;
--::::::::::
--cliintgr.ada
--::::::::::
-- This implementation of Package Body CLI is for IntegrAda.
-- It has been tested under IntegrAda 4.0.1 using MSDOS 3.3.
with UTIL;
package body CLI is

   LOCAL_ARGC : NATURAL := 1;
   -- Local ARGC value stored internally

   package STRING_LIST is

      NUMBER_OF_STRINGS : NATURAL := 0;

      procedure ADD_TO_LIST (ITEM : in STRING);
      function GET_FROM_LIST (ITEM : in NATURAL) return STRING;

   end STRING_LIST;

   package body STRING_LIST is

      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
      type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
         record
            DS   : STRING (1 .. LENGTH);
            NEXT : DYNAMIC_STRING;
         end record;

      FIRST : DYNAMIC_STRING := null;
      LAST  : DYNAMIC_STRING := null;

      procedure ADD_TO_LIST (ITEM : in STRING) is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    ADD_TO_LIST adds the ITEM string to the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    Create new DYNAMIC_STRING_OBJECT of the proper length
         --|    Set DS field of new object to the ITEM string
         --|    Set the NEXT field of the new object to NULL
         --|    If FIRST pointer is null
         --|      Set FIRST and LAST to point to the new object
         --|    Else
         --|      Set LAST.NEXT to point to the new object
         --|      Set LAST to point to the new object
         --|    End if
         --|    Increment NUMBER_OF_STRINGS
         --=========================================================

         TEMP : DYNAMIC_STRING;
      begin
         TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
         TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
         TEMP.NEXT                  := null;
         if FIRST = null then
            FIRST := TEMP;
            LAST  := TEMP;
         else
            LAST.NEXT := TEMP;
            LAST      := TEMP;
         end if;
         NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
      end ADD_TO_LIST;

      function GET_FROM_LIST (ITEM : in NATURAL) return STRING is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    GET_FROM_LIST returns the ITEM string from the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    If ITEM > 0
         --|        Advance to desired item
         --|    End If
         --|    Return the DS field of the desired item
         --=========================================================

         ROVER : DYNAMIC_STRING := FIRST;
      begin
         if ITEM > 0 then
            for I in 1 .. ITEM loop
               ROVER := ROVER.NEXT;
            end loop;
         end if;
         return ROVER.DS;
      end GET_FROM_LIST;

   end STRING_LIST;

   procedure INITIALIZE (PROGRAM_NAME        : in STRING;
                         COMMAND_LINE_PROMPT : in STRING) is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    INITIALIZE prompts the user for the command line
      --|    arguments and loads the linked list with them.
      --|DESIGN DESCRIPTION:
      --|    Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|    Set PROGRAM_NAME as first token
      --|    Obtain the command line string from VAX/VMS
      --|    Over number of characters in line, loop
      --|        Case CURRENT_STATE
      --|            When LOOKING_FOR_TOKEN
      --|                If character is not white-space
      --|                    Set CURRENT_STATE to IN_TOKEN
      --|                    If character is quote (")
      --|                        Set QUOTED to TRUE
      --|                        Set START to the character's index + 1
      --|                    Else
      --|                        Set QUOTED to FALSE
      --|                        Set START to the character's index
      --|                    End IF
      --|                End If
      --|            When IN_TOKEN
      --|                If QUOTED
      --|                    If character is quote (")
      --|                        Set STOP to the previous character's index
      --|                        Add slice from START to STOP to list
      --|                        Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|                    End If
      --|                ElsIF character is white-space
      --|                    Set STOP to the previous character's index
      --|                    Add slice from START to STOP to list
      --|                    Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|                End If
      --|        End Case
      --|    End Loop
      --|    If CURRENT_STATE is IN_TOKEN
      --|        Set STOP to the previous character's index
      --|        Add slice from START to STOP to list
      --|    End if
      --|    Set LOCAL_ARGC to NUMBER_OF_STRINGS
      --=========================================================

      ARGCOUNT      : NATURAL := 1;
      INLINE        : UTIL.COMMAND_STRING; -- for IntegrAda
      INLEN         : NATURAL;             -- for IntegrAda
      START         : NATURAL;
      STOP          : NATURAL;
      QUOTED        : BOOLEAN;

      type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
      CURRENT_STATE : STATE   := LOOKING_FOR_TOKEN;

   begin
      STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
      UTIL.COMMAND_LINE (INLINE, INLEN); -- INLINE is command line
      for I in 1 .. INLEN loop
         case CURRENT_STATE is
            when LOOKING_FOR_TOKEN  =>
               if INLINE (I) > ' ' then
                  CURRENT_STATE := IN_TOKEN;
                  if INLINE (I) = '"' then
                     QUOTED := TRUE;
                     START  := I;
                  else
                     QUOTED := FALSE;
                     START  := I;
                  end if;
               end if;
            when IN_TOKEN =>
               if QUOTED then
                  if INLINE (I) = '"' then
                     STOP          := I;
                     STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
                     CURRENT_STATE := LOOKING_FOR_TOKEN;
                  end if;
               elsif INLINE (I) <= ' ' then
                  STOP          := I - 1;
                  STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
                  CURRENT_STATE := LOOKING_FOR_TOKEN;
               end if;
         end case;
      end loop;
      if CURRENT_STATE = IN_TOKEN then
         STOP := INLEN;
         STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
      end if;
      LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
   end INITIALIZE;

   function ARGC return NATURAL is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGC returns the argument count.
      --|DESIGN DESCRIPTION:
      --|    Return LOCAL_ARGC
      --=========================================================

   begin
      return LOCAL_ARGC;
   end ARGC;

   function ARGV (INDEX : in NATURAL) return STRING is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGV returns the indicated argument string.
      --|DESIGN DESCRIPTION:
      --|    If INDEX is out of range, raise INVALID_INDEX
      --|    Return GET_FROM_LIST(INDEX)
      --=========================================================

   begin
      if INDEX >= LOCAL_ARGC then
         raise INVALID_INDEX;
      end if;
      return STRING_LIST.GET_FROM_LIST (INDEX);
   exception
      when INVALID_INDEX  =>
         raise ;
      when others    =>
         raise UNEXPECTED_ERROR;
   end ARGV;

end CLI;
--::::::::::
--climerdn.ada
--::::::::::
-- ****************************************
-- *                                      *
-- * CLI (Command Line Interface)         * BODY
-- *  for Meridian Ada, Version 3.x       *
-- *  requires AdaVantage Utility Library *
-- *                                      *
-- ****************************************
with ARG;  -- from AdaVantage Utility Library
package body CLI is

  NAME_OF_PROGRAM : STRING(1..100);
  NAME_OF_PROGRAM_LAST : NATURAL := 0;

  -- ...................................
  -- .                                 .
  -- . INITIALIZE                      . BODY
  -- .                                 .
  -- ...................................
  procedure INITIALIZE (PROGRAM_NAME        : in STRING;
                        COMMAND_LINE_PROMPT : in STRING) is
  begin
    NAME_OF_PROGRAM(1..PROGRAM_NAME'LENGTH) := PROGRAM_NAME;
    NAME_OF_PROGRAM_LAST := PROGRAM_NAME'LENGTH;
  exception
    when others => raise UNEXPECTED_ERROR;
  end INITIALIZE;

  -- ...................................
  -- .                                 .
  -- . ARGC (Argument Count)           . BODY
  -- .                                 .
  -- ...................................
  function ARGC return NATURAL is
  begin
    return ARG.COUNT;
  exception
    when others => raise UNEXPECTED_ERROR;
  end ARGC;

  -- ...................................
  -- .                                 .
  -- . ARGV (Argument Value)           . BODY
  -- .                                 .
  -- ...................................
  function ARGV (INDEX : in NATURAL) return STRING is
  begin
    if INDEX = 0 then
      return NAME_OF_PROGRAM(1..NAME_OF_PROGRAM_LAST);
    else
      if INDEX >= ARGC then
        raise INVALID_INDEX;
      else
        return ARG.DATA(POSITIVE(INDEX+1));
      end if;
    end if;
  exception
    when INVALID_INDEX => raise;
    when others => raise UNEXPECTED_ERROR;
  end ARGV;

end CLI;
--::::::::::
--cliverdx.ada
--::::::::::
-- This implementation of Package Body CLI is Verdix-specific (SUN).
-- The following Verdix Ada packages must be compiled into
-- the Ada library or an Ada program unit library containing these
-- packages must be placed in the library search path before this
-- package body is compiled:
--      standard/a_strings.a
--      standard/a_strings_b.a
--      standard/c_strings.a
--      standard/c_strings_b.a
--      verdixlib/cmd_line_s.a
--      verdixlib/cmd_line_b.a
-- Verdix Ada Development System, Version 5.41 and 5.5
with COMMAND_LINE;
with A_STRINGS;
package body CLI is

   LOCAL_ARGC : NATURAL := NATURAL (COMMAND_LINE.ARGC);
   -- Local value of ARGC stored internally

   procedure INITIALIZE (PROGRAM_NAME        : in STRING;
                         COMMAND_LINE_PROMPT : in STRING) is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    INITIALIZE prompts the user for the command line
      --|    arguments and loads the linked list with them.
      --|DESIGN DESCRIPTION:
      --|    Do nothing (no initialization required)
      --=========================================================

   begin
      null;
   end INITIALIZE;

   function ARGC return NATURAL is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGC returns the argument count.
      --|DESIGN DESCRIPTION:
      --|    Return LOCAL_ARGC
      --=========================================================

   begin
      return LOCAL_ARGC;
   end ARGC;

   function ARGV (INDEX : in NATURAL) return STRING is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGV returns the indicated argument string.
      --|DESIGN DESCRIPTION:
      --|    If INDEX is out of range, raise INVALID_INDEX
      --|    Return COMMAND_LINE.ARGV.all (INTEGER (INDEX)).all.S
      --=========================================================

   begin
      if INDEX >= LOCAL_ARGC then
         raise INVALID_INDEX;
      end if;
      return COMMAND_LINE.ARGV.all (INTEGER (INDEX)).all.S;
   exception
      when INVALID_INDEX  =>
         raise ;
      when others    =>
         raise UNEXPECTED_ERROR;
   end ARGV;

end CLI;
--::::::::::
--clivms.ada
--::::::::::
-- This implementation of Package Body CLI is for DEC Ada using VAX/VMS.
-- It has been tested under VAX/VMS 4.5 using DEC Ada Version 1.3-24.
-- Note: any executable produced which uses this package must be able to
-- read the command line parameters.  To do this, after producing the EXE
-- file via ACS LINK, you have to define a symbol like:
--    $ symbol:==$disk:[dir]exe-file-name
-- and then run the program by using the symbol:
--    $ symbol this is a test
package body CLI is

   LOCAL_ARGC : NATURAL := 1;
   -- Local ARGC value stored internally

   package STRING_LIST is

      NUMBER_OF_STRINGS : NATURAL := 0;

      procedure ADD_TO_LIST (ITEM : in STRING);
      function GET_FROM_LIST (ITEM : in NATURAL) return STRING;

   end STRING_LIST;

   package body STRING_LIST is

      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
      type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
         record
            DS   : STRING (1 .. LENGTH);
            NEXT : DYNAMIC_STRING;
         end record;

      FIRST : DYNAMIC_STRING := null;
      LAST  : DYNAMIC_STRING := null;

      procedure ADD_TO_LIST (ITEM : in STRING) is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    ADD_TO_LIST adds the ITEM string to the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    Create new DYNAMIC_STRING_OBJECT of the proper length
         --|    Set DS field of new object to the ITEM string
         --|    Set the NEXT field of the new object to NULL
         --|    If FIRST pointer is null
         --|      Set FIRST and LAST to point to the new object
         --|    Else
         --|      Set LAST.NEXT to point to the new object
         --|      Set LAST to point to the new object
         --|    End if
         --|    Increment NUMBER_OF_STRINGS
         --=========================================================

         TEMP : DYNAMIC_STRING;
      begin
         TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
         TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
         TEMP.NEXT                  := null;
         if FIRST = null then
            FIRST := TEMP;
            LAST  := TEMP;
         else
            LAST.NEXT := TEMP;
            LAST      := TEMP;
         end if;
         NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
      end ADD_TO_LIST;

      function GET_FROM_LIST (ITEM : in NATURAL) return STRING is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    GET_FROM_LIST returns the ITEM string from the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    If ITEM > 0
         --|        Advance to desired item
         --|    End If
         --|    Return the DS field of the desired item
         --=========================================================

         ROVER : DYNAMIC_STRING := FIRST;
      begin
         if ITEM > 0 then
            for I in 1 .. ITEM loop
               ROVER := ROVER.NEXT;
            end loop;
         end if;
         return ROVER.DS;
      end GET_FROM_LIST;

   end STRING_LIST;

   procedure INITIALIZE (PROGRAM_NAME        : in STRING;
                         COMMAND_LINE_PROMPT : in STRING) is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    INITIALIZE prompts the user for the command line
      --|    arguments and loads the linked list with them.
      --|DESIGN DESCRIPTION:
      --|    Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|    Set PROGRAM_NAME as first token
      --|    Obtain the command line string from VAX/VMS
      --|    Over number of characters in line, loop
      --|        Case CURRENT_STATE
      --|            When LOOKING_FOR_TOKEN
      --|                If character is not white-space
      --|                    Set CURRENT_STATE to IN_TOKEN
      --|                    If character is quote (")
      --|                        Set QUOTED to TRUE
      --|                        Set START to the character's index + 1
      --|                    Else
      --|                        Set QUOTED to FALSE
      --|                        Set START to the character's index
      --|                    End IF
      --|                End If
      --|            When IN_TOKEN
      --|                If QUOTED
      --|                    If character is quote (")
      --|                        Set STOP to the previous character's index
      --|                        Add slice from START to STOP to list
      --|                        Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|                    End If
      --|                ElsIF character is white-space
      --|                    Set STOP to the previous character's index
      --|                    Add slice from START to STOP to list
      --|                    Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|                End If
      --|        End Case
      --|    End Loop
      --|    If CURRENT_STATE is IN_TOKEN
      --|        Set STOP to the previous character's index
      --|        Add slice from START to STOP to list
      --|    End if
      --|    Set LOCAL_ARGC to NUMBER_OF_STRINGS
      --=========================================================

      ARGCOUNT      : NATURAL := 1;
      INLINE        : STRING (1 .. 132); -- for VAX/VMS
      START         : NATURAL;
      STOP          : NATURAL;
      QUOTED        : BOOLEAN;

      type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
      CURRENT_STATE : STATE   := LOOKING_FOR_TOKEN;

      -- Get command line from VAX/VMS
      procedure GET_FOREIGN (LINE : out STRING);
      pragma INTERFACE (EXTERNAL, GET_FOREIGN);
      pragma IMPORT_VALUED_PROCEDURE (GET_FOREIGN,
                                      "LIB$GET_FOREIGN",
                                      (STRING),
                                      (DESCRIPTOR(S)));

   begin
      STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
      GET_FOREIGN (INLINE); -- INLINE is command line from VAX/VMS
      for I in INLINE'RANGE loop
         case CURRENT_STATE is
            when LOOKING_FOR_TOKEN  =>
               if INLINE (I) > ' ' then
                  CURRENT_STATE := IN_TOKEN;
                  if INLINE (I) = '"' then
                     QUOTED := TRUE;
                     START  := I;
                  else
                     QUOTED := FALSE;
                     START  := I;
                  end if;
               end if;
            when IN_TOKEN =>
               if QUOTED then
                  if INLINE (I) = '"' then
                     STOP          := I;
                     STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
                     CURRENT_STATE := LOOKING_FOR_TOKEN;
                  end if;
               elsif INLINE (I) <= ' ' then
                  STOP          := I - 1;
                  STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
                  CURRENT_STATE := LOOKING_FOR_TOKEN;
               end if;
         end case;
      end loop;
      if CURRENT_STATE = IN_TOKEN then
         STOP := INLINE'LAST;
         STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
      end if;
      LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
   end INITIALIZE;

   function ARGC return NATURAL is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGC returns the argument count.
      --|DESIGN DESCRIPTION:
      --|    Return LOCAL_ARGC
      --=========================================================

   begin
      return LOCAL_ARGC;
   end ARGC;

   function ARGV (INDEX : in NATURAL) return STRING is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGV returns the indicated argument string.
      --|DESIGN DESCRIPTION:
      --|    If INDEX is out of range, raise INVALID_INDEX
      --|    Return GET_FROM_LIST(INDEX)
      --=========================================================

   begin
      if INDEX >= LOCAL_ARGC then
         raise INVALID_INDEX;
      end if;
      return STRING_LIST.GET_FROM_LIST (INDEX);
   exception
      when INVALID_INDEX  =>
         raise ;
      when others    =>
         raise UNEXPECTED_ERROR;
   end ARGV;

end CLI;